﻿<%
Class aspJSON
		Public data
		Private p_JSONstring
		private aj_in_string, aj_in_escape, aj_i_tmp, aj_char_tmp, aj_s_tmp, aj_line_tmp
		private aj_line, aj_lines, aj_currentlevel, aj_currentkey, aj_currentvalue, aj_newlabel, aj_RegExp, aj_colonfound
		Private Sub Class_Initialize()
			Set data = Collection()
			Set aj_RegExp = New RegExp
			aj_RegExp.Pattern = "\s{0,}(\S{1}[\s,\S]*\S{1})\s{0,}"
			aj_RegExp.Global = False
			aj_RegExp.IgnoreCase = True
			aj_RegExp.Multiline = True
		End Sub
		Private Sub Class_Terminate()
			Set data = Nothing
			Set aj_RegExp = Nothing
		End Sub
		Public Sub loadJSON(inputsource)
			inputsource = aj_MultilineTrim(inputsource)
			If Len(inputsource) = 0 Then Err.Raise 1, "loadJSON Error", "No data to load."
			select case Left(inputsource, 1)
				case "{", "["
				case else
					With (Server.CreateObject("Msxml2.ServerXMLHTTP"))
						.open "GET", inputsource, False
						.setRequestHeader "Content-Type", "text/json"
						.setRequestHeader "CharSet", "UTF-8"
						.Send
						inputsource = .ResponseText
					End With			
			end select
			p_JSONstring = CleanUpJSONstring(inputsource)
			aj_lines = Split(p_JSONstring, Chr(13) & Chr(10))
			Dim level(99)
			aj_currentlevel = 1
			Set level(aj_currentlevel) = data
			For Each aj_line In aj_lines
				aj_currentkey = ""
				aj_currentvalue = ""
				If Instr(aj_line, ":") > 0 Then
					aj_in_string = False
					aj_in_escape = False
					aj_colonfound = False
					For aj_i_tmp = 1 To Len(aj_line)
						If aj_in_escape Then
							aj_in_escape = False
						Else
							Select Case Mid(aj_line, aj_i_tmp, 1)
								Case """"
									aj_in_string = Not aj_in_string
								Case ":"
									If Not aj_in_escape And Not aj_in_string Then
										aj_currentkey = Left(aj_line, aj_i_tmp - 1)
										aj_currentvalue = Mid(aj_line, aj_i_tmp + 1)
										aj_colonfound = True
										Exit For
									End If
								Case "\"
									aj_in_escape = True
							End Select
						End If
					Next
					if aj_colonfound then
						aj_currentkey = aj_Strip(aj_JSONDecode(aj_currentkey), """")
						If Not level(aj_currentlevel).exists(aj_currentkey) Then level(aj_currentlevel).Add aj_currentkey, ""
					end if
				End If
				If right(aj_line,1) = "{" Or right(aj_line,1) = "[" Then
					If Len(aj_currentkey) = 0 Then aj_currentkey = level(aj_currentlevel).Count
					Set level(aj_currentlevel).Item(aj_currentkey) = Collection()
					Set level(aj_currentlevel + 1) = level(aj_currentlevel).Item(aj_currentkey)
					aj_currentlevel = aj_currentlevel + 1
					aj_currentkey = ""
				ElseIf right(aj_line,1) = "}" Or right(aj_line,1) = "]" or right(aj_line,2) = "}," Or right(aj_line,2) = "]," Then
					aj_currentlevel = aj_currentlevel - 1
				ElseIf Len(Trim(aj_line)) > 0 Then
					if Len(aj_currentvalue) = 0 Then aj_currentvalue = aj_line
					aj_currentvalue = getJSONValue(aj_currentvalue)
					If Len(aj_currentkey) = 0 Then aj_currentkey = level(aj_currentlevel).Count
					level(aj_currentlevel).Item(aj_currentkey) = aj_currentvalue
				End If
			Next
		End Sub
		Public Function Collection()
			set Collection = Server.CreateObject("Scripting.Dictionary")
		End Function
		Public Function AddToCollection(dictobj)
			if TypeName(dictobj) <> "Dictionary" then Err.Raise 1, "AddToCollection Error", "Not a collection."
			aj_newlabel = dictobj.Count
			dictobj.Add aj_newlabel, Collection()
			set AddToCollection = dictobj.item(aj_newlabel)
		end function
		Private Function CleanUpJSONstring(aj_originalstring)
			aj_originalstring = Replace(aj_originalstring, Chr(13) & Chr(10), "")
			aj_originalstring = Mid(aj_originalstring, 2, Len(aj_originalstring) - 2)
			aj_in_string = False : aj_in_escape = False : aj_s_tmp = ""
			For aj_i_tmp = 1 To Len(aj_originalstring)
				aj_char_tmp = Mid(aj_originalstring, aj_i_tmp, 1)
				If aj_in_escape Then
					aj_in_escape = False
					aj_s_tmp = aj_s_tmp & aj_char_tmp
				Else
					Select Case aj_char_tmp
						Case "\" : aj_s_tmp = aj_s_tmp & aj_char_tmp : aj_in_escape = True
						Case """" : aj_s_tmp = aj_s_tmp & aj_char_tmp : aj_in_string = Not aj_in_string
						Case "{", "["
							aj_s_tmp = aj_s_tmp & aj_char_tmp & aj_InlineIf(aj_in_string, "", Chr(13) & Chr(10))
						Case "}", "]"
							aj_s_tmp = aj_s_tmp & aj_InlineIf(aj_in_string, "", Chr(13) & Chr(10)) & aj_char_tmp
						Case "," : aj_s_tmp = aj_s_tmp & aj_char_tmp & aj_InlineIf(aj_in_string, "", Chr(13) & Chr(10))
						Case Else : aj_s_tmp = aj_s_tmp & aj_char_tmp
					End Select
				End If
			Next
			CleanUpJSONstring = ""
			aj_s_tmp = split(aj_s_tmp, Chr(13) & Chr(10))
			For Each aj_line_tmp In aj_s_tmp
				aj_line_tmp = replace(replace(aj_line_tmp, chr(10), ""), chr(13), "")
				CleanUpJSONstring = CleanUpJSONstring & aj_Trim(aj_line_tmp) & Chr(13) & Chr(10)
			Next
		End Function
		Private Function getJSONValue(ByVal val)
			val = Trim(val)
			If Left(val,1) = ":"  Then val = Mid(val, 2)
			If Right(val,1) = "," Then val = Left(val, Len(val) - 1)
			val = Trim(val)
			Select Case val
				Case "true"  : getJSONValue = True
				Case "false" : getJSONValue = False
				Case "null" : getJSONValue = Null
				Case Else
					If (Instr(val, """") = 0) Then
						If IsNumeric(val) Then
							getJSONValue = CDbl(val)
						Else
							getJSONValue = val
						End If
					Else
						If Left(val,1) = """" Then val = Mid(val, 2)
						If Right(val,1) = """" Then val = Left(val, Len(val) - 1)
						getJSONValue = aj_JSONDecode(Trim(val))
					End If
			End Select
		End Function
		Private JSONoutput_level
		Public Function JSONoutput()
			dim wrap_dicttype, aj_label
			JSONoutput_level = 1
			wrap_dicttype = "[]"
			For Each aj_label In data
				 If Not aj_IsInt(aj_label) Then wrap_dicttype = "{}"
			Next
			JSONoutput = Left(wrap_dicttype, 1) & Chr(13) & Chr(10) & GetDict(data) & Right(wrap_dicttype, 1)
		End Function
		Public Function JsonWrite()
			dim wrap_dicttype, aj_label
			JSONoutput_level = 1
			wrap_dicttype = "[]"
			For Each aj_label In data
				 If Not aj_IsInt(aj_label) Then wrap_dicttype = "{}"
			Next
			val = Left(wrap_dicttype, 1) & GetDict(data) & Right(wrap_dicttype, 1)
			val = Replace(val, Chr(8), "")
			val = Replace(val, Chr(12), "")
			val = Replace(val, Chr(10), "")
			val = Replace(val, Chr(13), "")
			val = Replace(val, Chr(9), "")
			val = Replace(val, Chr(32), "")
			'val = Replace(val, "/", "\/")
			'val = Replace(val, "?", "\?")
			JsonWrite = Trim(val)
		End Function
		Private Function GetDict(objDict)
			dim aj_item, aj_keyvals, aj_label, aj_dicttype
			For Each aj_item In objDict
				Select Case TypeName(objDict.Item(aj_item))
					Case "Dictionary"
						GetDict = GetDict & Space(JSONoutput_level * 4)					
						aj_dicttype = "[]"
						For Each aj_label In objDict.Item(aj_item).Keys
							 If Not aj_IsInt(aj_label) Then aj_dicttype = "{}"
						Next
						If aj_IsInt(aj_item) Then
							GetDict = GetDict & (Left(aj_dicttype,1) & Chr(13) & Chr(10))
						Else
							GetDict = GetDict & ("""" & aj_JSONEncode(aj_item) & """" & ": " & Left(aj_dicttype,1) & Chr(13) & Chr(10))
						End If
						JSONoutput_level = JSONoutput_level + 1
						
						aj_keyvals = objDict.Keys
						GetDict = GetDict & (GetSubDict(objDict.Item(aj_item)) &_
						Space(JSONoutput_level * 4) & Right(aj_dicttype,1) & aj_InlineIf(aj_item = aj_keyvals(objDict.Count - 1),"" , ",") & Chr(13) & Chr(10))
					Case Else
						aj_keyvals =  objDict.Keys
						GetDict = GetDict & (Space(JSONoutput_level * 4) &_
						aj_InlineIf(aj_IsInt(aj_item), "", """" & aj_JSONEncode(aj_item) & """: ") & WriteValue(objDict.Item(aj_item)) &_
						aj_InlineIf(aj_item = aj_keyvals(objDict.Count - 1),"" , ",") & Chr(13) & Chr(10))
				End Select
			Next
		End Function
		Private Function aj_IsInt(val)
			aj_IsInt = (TypeName(val) = "Integer" Or TypeName(val) = "Long")
		End Function
		Private Function GetSubDict(objSubDict)
			GetSubDict = GetDict(objSubDict)
			JSONoutput_level= JSONoutput_level -1
		End Function
		Private Function WriteValue(ByVal val)
			Select Case TypeName(val)
				Case "Double", "Integer", "Long": WriteValue = replace(val, ",", ".")
				Case "Null"						: WriteValue = "null"
				Case "Boolean"					: WriteValue = aj_InlineIf(val, "true", "false")
				Case Else						: WriteValue = """" & aj_JSONEncode(val) & """"
			End Select
		End Function
		Private Function aj_JSONEncode(ByVal val)
			val = Replace(val, "\", "\\")
			val = Replace(val, """", "\""")
			'val = Replace(val, "/", "\/")
			val = Replace(val, Chr(8), "\b")
			val = Replace(val, Chr(12), "\f")
			val = Replace(val, Chr(10), "\n")
			val = Replace(val, Chr(13), "\r")
			val = Replace(val, Chr(9), "\t")
			aj_JSONEncode = Trim(val)
		End Function
		Private Function aj_JSONDecode(ByVal val)
			val = Replace(val, "\""", """")
			val = Replace(val, "\\", "\")
			val = Replace(val, "\/", "/")
			val = Replace(val, "\b", Chr(8))
			val = Replace(val, "\f", Chr(12))
			val = Replace(val, "\n", Chr(10))
			val = Replace(val, "\r", Chr(13))
			val = Replace(val, "\t", Chr(9))
			aj_JSONDecode = Trim(val)
		End Function
		Private Function aj_InlineIf(condition, returntrue, returnfalse)
			If condition Then aj_InlineIf = returntrue Else aj_InlineIf = returnfalse
		End Function
		Private Function aj_Strip(ByVal val, stripper)
			If Left(val, 1) = stripper Then val = Mid(val, 2)
			If Right(val, 1) = stripper Then val = Left(val, Len(val) - 1)
			aj_Strip = val
		End Function
		Private Function aj_MultilineTrim(TextData)
			aj_MultilineTrim = aj_RegExp.Replace(TextData, "$1")
		End Function
		private function aj_Trim(val)
			aj_Trim = Trim(val)
			Do While Left(aj_Trim, 1) = Chr(9) : aj_Trim = Mid(aj_Trim, 2) : Loop
			Do While Right(aj_Trim, 1) = Chr(9) : aj_Trim = Left(aj_Trim, Len(aj_Trim) - 1) : Loop
			aj_Trim = Trim(aj_Trim)
		end function
	End Class
'案例用法 20220707'
' dim str,obj,oJSON
' str="{""dataA"":{""area"":"""",""country"":""XX"",""isp_id"":""local"",""queryIp"":""127.0.0.1"",""city"":""内网IP"",""ip"":""127.0.0.1"",""isp"":""内网IP"",""county"":"""",""region_id"":""xx"",""area_id"":"""",""county_id"":null,""region"":""XX"",""country_id"":""xx"",""city_id"":""local""},""msg"":""query success"",""code"":0}"
' Set oJSON = New aspJSON
' oJSON.loadJSON(str) 
' response.write(oJSON.data("dataA")("city"))

 

'json处理
Function parseJSON(str)
	dim scriptCtrl
    If Not IsObject(scriptCtrl) Then
        Set scriptCtrl = Server.CreateObject("MSScriptControl.ScriptControl")
        scriptCtrl.Language = "JScript"
        scriptCtrl.AddCode "Array.prototype.get = function(x) { return this[x]; }; var result = null;"
    End If
    scriptCtrl.ExecuteStatement "result = " & str & ";"
    Set parseJSON = scriptCtrl.CodeObject.result
End Function

'字典转Json
function dictionaryToJson(obj)
	dim s,c,key
	For Each s In obj
		key=s'phpno
		s=obj(key)'phpno 
		if c<>"" then
			c=c & ","
		end if
		c=c & key & ":"""& JsEncode__(s) &""""
	next
	c="[{"& c &"}]"
	dictionaryToJson=c
end function

%>